home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Janim / tests / test_animbrush.f < prev    next >
Encoding:
FORTH Source  |  1992-01-26  |  3.4 KB  |  210 lines
  1. \ Demonstrate various features of the JForth ANIM system.
  2.  
  3. include? choose ju:random
  4. include? picture jiff:load_pic
  5. include? anim janim:load_anim
  6.  
  7. ANEW TASK-TEST_ANIMBRUSH
  8.  
  9. \ You may substitute your own files here if you wish.
  10. : $BACKG.FILENAME  " JPics:Mountains.pic" ;
  11. : $HEADS.FILENAME  " JPics:Bird.anbr" ;
  12.  
  13. \ Declare structures needed
  14. picture backg0
  15. picture backg1
  16. animbrush BigBird
  17. animbrush testabr
  18.  
  19. 10 value xp
  20. 10 value yp
  21. 7 value dx
  22. 7 value dy
  23.  
  24. \ Test LOAD and SAVE
  25. : TEST.LOAD&SAVE ( <infilename> <outfilename>-- )
  26.     testabr abr.load? ?goto.error
  27.     testabr abr.stats
  28.     BEGIN
  29.         testabr abr.advance
  30.         8 wait.frames
  31.         ?closebox ?terminal OR
  32.     UNTIL
  33.     testabr abr.save? ?goto.error
  34.     testabr abr.free
  35.     exit
  36. ERROR:
  37.     ." Error!" cr
  38.     testabr abr.free
  39. ;
  40.  
  41. : SHOW.ABR ( <infilename> -- )
  42.     gr.init
  43.     testabr abr.load? ?goto.error
  44.     testabr abr.stats
  45.     BEGIN
  46.         testabr abr.advance
  47.         8 wait.frames
  48.         ?closebox ?terminal OR
  49.     UNTIL
  50.     testabr abr.free
  51.     gr.term
  52.     exit
  53. ERROR:
  54.     ." Error!" cr
  55.     testabr abr.free
  56.     gr.term
  57. ;
  58.  
  59. \ Show animbrush over a picture.
  60. : TAB.INIT ( -- error? )
  61.     gr.init
  62.     $BACKG.FILENAME backg0 $pic.load  \ load two buffers
  63.     $BACKG.FILENAME backg1 $pic.load
  64.     $HEADS.FILENAME BigBird $abr.load? ?goto.error
  65. \
  66.     abr_pingpong BigBird ..! abr_flags
  67.     BigBird abr.stats
  68.     0 BigBird pic.alloc.backup? ?goto.error
  69.     1 BigBird pic.alloc.backup? ?goto.error
  70.     xp yp 0 BigBird pic.backup.nth
  71.     xp yp 1 BigBird pic.backup.nth
  72.     FALSE
  73.     EXIT
  74. ERROR:
  75.     TRUE
  76. ;
  77.  
  78. : TAB.TERM
  79.     backg1 pic.free
  80.     backg0 pic.free
  81.     BigBird abr.free
  82.     gr.term
  83. ;
  84. if.forgotten tab.term
  85.  
  86. : TAB.MOVE ( -- )
  87. \ calculate new position, reflect off boundarys
  88. \ let it go off screen to test clipping
  89.     xp 300 >  xp -20 < OR
  90.     IF
  91.         dx negate -> dx
  92.     THEN
  93.     dx +-> xp
  94.     yp 160 >  yp -30 < OR
  95.     IF
  96.         dy negate -> dy
  97.     THEN
  98.     dy +-> yp
  99. ;
  100.  
  101. : TAB.NEXT.SPIN { pict N -- }
  102.     pict pic.drawto
  103.     N BigBird pic.restore.nth
  104.     xp yp N BigBird pic.backup.nth
  105.     xp yp BigBird abr.trans.blit
  106.     pict pic.display \ or you can call PIC.VIEW for speed but
  107.     \ watch out for strange Intuition effects.
  108.     2 wait.frames
  109. \
  110.     BigBird abr.advance
  111.     tab.move
  112. ;
  113.  
  114. : TAB.SPIN ( -- )
  115.     BEGIN
  116.         backg0 0 tab.next.spin
  117.         backg1 1 tab.next.spin
  118.         ?terminal ?closebox OR
  119.     UNTIL
  120. ;
  121.  
  122. : TAB
  123.     tab.init 0=
  124.     IF
  125.         tab.spin
  126.     THEN
  127.     tab.term
  128. ;
  129.  
  130. \ Test editing
  131.  
  132. animbrush newabr
  133. picture pic0
  134. picture pic1
  135.  
  136. : TABED.TERM
  137.     newabr abr.free
  138.     pic0 pic.free
  139.     pic1 pic.free
  140.     tab.term
  141. ;
  142. if.forgotten tabed.term
  143.  
  144. : TABED.INIT ( -- error? )
  145.     tab.init dup 0=
  146.     IF
  147.         drop
  148.         " JPics:Ship.br" pic0 $pic.load?
  149.     THEN
  150. ;
  151.  
  152. : TABED.MAKE ( -- error? , make animbrush from pictures )
  153.     pic0 pic1 pic.duplicate? dup 0=
  154.     IF
  155.         drop
  156.         pic0 pic1 pic.copy  \ only needed for old bad PIC.DUPLICATE
  157.         pic1 pic.drawto
  158.         4 gr.color!
  159.         0 0 20 10 gr.rect
  160.         backg0 pic.drawto
  161.         pic0 pic1 newabr abr.build?
  162.     THEN
  163. ;
  164.  
  165. : TABED.CHANGE ( -- error? , insert new picture )
  166.     0 newabr abr.dup.cel? dup 0=
  167.     IF
  168.         drop
  169.         pic1 pic.drawto
  170.         7 gr.color!
  171.         10 10 40 30 gr.rect
  172.         backg0 pic.drawto
  173.         pic1 1 newabr abr.replace.cel?
  174.     THEN
  175. ;
  176.  
  177. : TABED.SHOW
  178.     BEGIN
  179.         0 0 backg1 pic.blit
  180.         120 40 newabr abr.trans.blit
  181.         newabr abr.advance
  182.         30 wait.frames
  183.         ?terminal ?closebox OR
  184.     UNTIL
  185. ;
  186.  
  187. : TABED.DELETE ( -- error? )
  188.     1 newabr abr.delete.cel?
  189. ;
  190.  
  191. : TABED
  192.     tabed.init ?goto.error
  193.         ." TABED - INIT passed!" cr
  194.     tabed.make ?goto.error
  195.         ." TABED - MAKE passed!" cr
  196.     tabed.change ?goto.error
  197.         ." TABED - CHANGE passed!" cr
  198. \
  199.     tabed.show
  200.     tabed.delete ?goto.error
  201.         ." TABED - DELETE passed!" cr
  202.     tabed.show
  203. \
  204. ERROR:
  205.     tabed.term
  206. ;
  207.  
  208. ." Enter:   TAB or TABED" cr
  209.  
  210.